//----------------------------------------------------------------------------
//
// Autor : MatthiasG. (turboPASCAL)
// Website : [url]http://www.mgsdh.de.vu[/url]
// Version : 2.00 lite
// Date : Jun 2006
// Changes : * Ver 1.9 -> Ver 2.0 Debugzeugs eingebaut
// * Ver 1.8 -> Unterstutzung von RGB-Dateien
//
// Hint : * in der Datei "pngimage.pas" den Compilerschalter
// {$DEFINE UseDelphi} durch {.$DEFINE UseDelphi} ersetzen
// * nicht 100% Optimiert fur nonVCL
//----------------------------------------------------------------------------

unit PNGLoader;

{$WARNINGS OFF}

// For Debug only: --------------------
{.$DEFINE ViewLoadedFilesOnConsole}
// ------------------------------------

interface

uses
  Windows,
  OpenGL,
  pngimage,
  sysutils; // fur Uppercase und solch einen Kase...

  function LoadTexture(const Filename: String; var Texture: GLuint;
    const LoadFromRes: Boolean = FALSE): Boolean;

  function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint;
    Format, atype: GLenum; Data: Pointer): GLint; stdcall; external 'glu32.dll';
  procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external OpenGL32;
  procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external OpenGL32;
  procedure glDeleteTextures(n: Integer; textures: PGLuint); stdcall; external OpenGL32;


implementation

{------------------------------------------------------------------}
{  Create the Texture                                              }
{------------------------------------------------------------------}
function CreateTexture(Width, Height, Format: Word; pData: Pointer): Integer;
var
  Texture: GLuint;
begin
  glGenTextures(1, Texture);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE); {Texture blends with object background}
// glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL); {Texture does NOT blend with object background}

  { Select a filtering type. BiLinear filtering produces very good results with little performance impact
    GL_NEAREST              - Basic texture (grainy looking texture)
    GL_LINEAR                - BiLinear filtering
    GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
    GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
  }  

  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); { only first two can be used }
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); { all of the above can be used }

  if Format = GL_RGBA then
    gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
  else
    gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
// glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData); // Use when not wanting mipmaps to be built by openGL

  {$IFDEF ViewLoadedFilesOnConsole}
    if Format = GL_RGBA
      then Write(' -> CreateTexture (RGBA): ')
      else Write(' -> CreateTexture (RGB): ');
    WriteLn(Width, 'x', Height);
  {$ENDIF ViewLoadedFilesOnConsole}

  result := Texture;
end;

{------------------------------------------------------------------}
{  Load PNG textures                                               }
{------------------------------------------------------------------}
function LoadPNGTexture(Filename: String; var Texture: GLuint; LoadFromResource: Boolean): Boolean;
var
  Data : Array of DWORD;
  W, Width : Integer;
  H, Height : Integer;
  AlphaPtr: PByte;
  PNG : TPngObject;
begin
  {$IFDEF ViewLoadedFilesOnConsole}
    Writeln('LoadTexture "Type PNG": ', Filename);
  {$ENDIF ViewLoadedFilesOnConsole}

  PNG := TPngObject.Create;

  if LoadFromResource then // Load from resource
  begin
    PNG.LoadFromResourceName(hInstance, copy(Filename, 1, Pos('.', Filename)-1));
    // to do: on Error exit
    // Result := FALSE;
  end else
  begin
    PNG.LoadFromFile(Filename);
    // to do: on Error exit
    // Result := FALSE;
  end;

  //
  // No, Palettenzeugs will ich nicht.
  /////////////////////////////////////////////////////////////////////////
  if PNG.Header.ColorType = COLOR_PALETTE then
  begin
    MessageBox(0,
      PChar('Dieser PNG-Typ in der Datei:'#13#10'"' + Filename +
            '"'#13#10'wird nicht unterstutzt.'),
      PChar('Information:' + IntToStr(PNG.Header.ColorType)),
      MB_APPLMODAL or MB_SYSTEMMODAL or MB_ICONINFORMATION or MB_OK);
    Result := FALSE;
    exit;
  end;

  Width := PNG.Width;
  Height := PNG.Height;
  SetLength(Data, Width * Height);

  if (PNG.Header.ColorType = COLOR_RGB) or
     (PNG.Header.ColorType = COLOR_GRAYSCALE) then
  begin
    For H := 0 to Height - 1 do
      For W := 0 to Width - 1 do
        Data[W + (H * Width)] := $FF000000 or PNG.Pixels[W, (Height-1)-H];
  end else
  if (PNG.Header.ColorType = COLOR_RGBALPHA) or
     (PNG.Header.ColorType = COLOR_GRAYSCALEALPHA) then
  begin
    for H := 0 to Height - 1 do
    begin
      AlphaPtr := PByte(PNG.AlphaScanline[(Height-1)-H]);
      for W := 0 to Width - 1 do
      begin
        Data[W + (H * Width)] := (($FF000000 and (AlphaPtr^ shl 24)) or PNG.Pixels[W, (Height-1)-H]);
        Inc(AlphaPtr);
      end;
    end;
  end;

  PNG.free;

  Texture := CreateTexture(Width, Height, GL_RGBA, @Data[0]);

  Result := TRUE;
end;

{------------------------------------------------------------------}
{  Determines file type and sends to correct function              }
{------------------------------------------------------------------}
function LoadTexture(const Filename: String; var Texture: GLuint; const LoadFromRes: Boolean = FALSE): Boolean;
begin
  result := False;
  if copy(Uppercase(filename), length(filename)-3, 4) = '.PNG' then
    LoadPNGTexture(Filename, Texture, LoadFromRes);
end;

{$IFDEF ViewLoadedFilesOnConsole}
initialization
  AllocConsole;
  SetConsoleTitle('Unit PNGLoader:');

finalization
  FreeConsole;
{$ENDIF ViewLoadedFilesOnConsole}

end.
